#!/usr/bin/perl -w
# =================================================================
# Begin cut to include XNAT tools Perl libraries
# =================================================================
my ($prog,$progdir);
BEGIN {
  if($0 =~ m{(.*)/(.*?)$}) {
    ($progdir,$prog) = ($1,$2);
  } else {
    ($progdir,$prog) = ($0,'');
  }
  $progdir = '.' unless $progdir;
  push @INC, "$progdir/lib", "$progdir";
  #print join(':',@INC),"\n";
}
# =================================================================
# End cut to include XNAT tools Perl libraries
# =================================================================

use strict;
use Time::HiRes qw( gettimeofday tv_interval );
use Getopt::Long qw(:config no_ignore_case);
use Data::Dumper;
use DBI;

use XNAT::DICOM::DirectoryParser;
use XNAT::DICOM::Session;
use XNAT::DICOM::Series;
use XNAT::DICOM::File;
use File::Basename;

my $prearchive = "/mnt/Data/PreArchive";
my $incoming_dir = "/mnt/Data/Incoming";
my $prefix = "XNAT_";

# =================================================================
# Get command-line options.
# =================================================================
my $opts = { 'db-name'=>'dcm_data', 'db-host'=>'localhost', 'db-user'=>$prog,
	     'fork'=>0,
	     'db-pass'=>'%'.$prog.'4U',
	     'store'=>0, 'no-log'=>0, 'prearchive' => '', 'in-dir'=>'',
	     'dir-prefix'=>'','verbose'=>0,'debug'=>0,'extra'=>0,'help'=>0
	   };
GetOptions($opts,
	   'db-name=s',
	   'db-host=s',
	   'db-user=s',
	   'db-pass=s',
           'fork',
           'import',
	   'store-all',
	   'store-stats',
	   'no-log',
           'prearchive|p=s',
           'in-dir|i=s',
           'dir-prefix|f=s',
           'verbose|v+',
           'debug|d+',
           'extra|e',
           'help|h|?',
          )
  || die &usage, "ERROR: Did not understand command line options.\n";
# =================================================================
# Output usage statement.
# =================================================================
if($opts->{help}) {
  usage();
  exit 0;
}

sub usage {
  print << "END_OF_PRINT";
Usage: $prog [-v] [-d] [-e] [-o dir] raw_dicom_directory
---------------------------------------------------------------------------
--db-name db       | database name to store data into (default: dcm_data)
--db-host host     | database host to which to connect (default: localhost)
--db-user user     | database user with which to connect (default: $prog)
--db-pass pass     | database password (default: none, prompt for it)
--store-all        | store all data into the database
--store-stats      | store only processing stats into the database
--no-log           | don't log data to $prog.csv
--prearchive dir   | move to the prearchive directory 'dir'.
--in-dir dir       | the base directory (where storescp puts study
                   |   directories)
--dir-prefix prfix | the --sort-conc-studies passed to storescp
--debug            | be really verbose and save DICOM headers to a file in
                   |   the output directory (named SESSION_ID-headers.txt)
--extra            | If the script can figure out more information to put
                   |   into the XNAT-Compliant XML, do so. Default is to
                   |   mimic the XNAT DicomServer output and not add info.
--verbose          | be verbose. The more -v -v -v, the more verbose. -d
                   |   sets the verbosity to '2' so -v -d is the
                   |   same STDOUT output as as -v -v -v .
---------------------------------- HELP -----------------------------------
-h or -? or --help for this screen
END_OF_PRINT
	"";
}

my $start_t0 = [gettimeofday];

my $dbh;
my $prep = {};
my %headerType2Id;
my %headerValue2Id;
my %header2Id;
my $stats = {};

if($opts->{'store-all'} || $opts->{'store-stats'}) {
	my $t0=[gettimeofday];
	print "Connecting to '$opts->{'db-name'}'".'@'."'$opts->{'db-host'}' user='$opts->{'db-user'}',pass='$opts->{'db-pass'}'\n";
	my $string = 'DBI:mysql:database='.$opts->{'db-name'}.';host='.$opts->{'db-host'};
	$dbh = DBI->connect($string,$opts->{'db-user'},$opts->{'db-pass'});
	if($dbh) {
		my @headerTypes = @{$dbh->selectall_arrayref("SELECT id,name FROM HeaderType;", { Slice => {} })};
		foreach my $h (@headerTypes) {$headerType2Id{$h->{name}}=$h->{id};}
		$prep->{InsertHeaderType2HeaderValue} = $dbh->prepare("
INSERT IGNORE INTO HeaderType2HeaderValue
   SET headertype_id=?,
       headervalue_id=?
;");
		$prep->{SelectHeaderType2HeaderValueId} = $dbh->prepare("SELECT id FROM HeaderType2HeaderValue WHERE headertype_id=? AND headervalue_id=?;");
		$prep->{InsertHeaderType} = $dbh->prepare("INSERT IGNORE INTO HeaderType SET name=?;");
		$prep->{InsertHeaderValue} = $dbh->prepare("INSERT IGNORE INTO HeaderValue SET text=?;");
		$prep->{InsertInstance2Header} = $dbh->prepare("INSERT IGNORE INTO Instance2Header SET instance_id=?,header_id=?;");
		$prep->{InsertSeries2Header} = $dbh->prepare("INSERT IGNORE INTO Series2Header SET series_id=?,header_id=?;");
		$prep->{InsertSession2Header} = $dbh->prepare("INSERT IGNORE INTO Session2Header SET session_id=?,header_id=?;");
		$prep->{SelectHeaderValueId} = $dbh->prepare("SELECT id FROM HeaderValue WHERE text=?");
		$prep->{InsertSession} = $dbh->prepare("
INSERT INTO Session
   SET uid=?,
       label=?,
       date_sent=?,
       date_loaded=NOW(),
       date_acquired=?,
       subject_id=NULL,
       size_on_disk=?,
       uncompressed_size=?
;");
		$prep->{InsertSeries} = $dbh->prepare("
INSERT INTO Series
   SET uid=?,
       series_number=?,
       label=?,
       series_description=?,
       xnat_type=?,
       session_id=?,
       size_on_disk=?,
       uncompressed_size=?
;");
		$prep->{InsertInstance} = $dbh->prepare("
INSERT INTO Instance
   SET uid=?,
       instance_number=?,
       label=?,
       series_id=?,
       session_id=?
;");
		$prep->{InsertFileName} = $dbh->prepare("INSERT IGNORE INTO FileName SET name=?;");
		$prep->{SelectFileNameId} = $dbh->prepare("SELECT id FROM FileName WHERE name=?;");
		$prep->{InsertDirectory} = $dbh->prepare("INSERT IGNORE INTO Directory SET full_path=?;");
		$prep->{SelectDirectoryId} = $dbh->prepare("SELECT id FROM Directory WHERE full_path=?;");
		$prep->{InsertFile} = $dbh->prepare("
INSERT IGNORE INTO File
   SET loaded=NOW(),
       filename_id=?,
       directory_id=?,
       size_on_disk=?,
       uncompressed_md5_checksum=?,
       uncompressed_size=?,
       still_exists=1,
       moved_to_file_id=NULL
;");
	} else {
		warn "ERROR: Failed to connect to $opts->{'db-name'}@$opts->{'db-host'}: $DBI::errstr, will not store in db.\n";
	}
	$stats->{prepare_statements_time} = tv_interval($t0);
	print "Prepared Statements in $stats->{prepare_statements_time} seconds.\n";
}

$main::verbose = $opts->{verbose};
$main::verbose += 2 if $opts->{debug};

if(! @ARGV) { die &usage, "ERROR: You must specify a directory to process.\n"; }

if($opts->{fork}) {
  my $pid = fork();
  if (not defined $pid) {
    warn "WARNING: Unable to fork, will continue without it.\n";
  } elsif ($pid == 0) {
    print "CHILD ($$) forked and running..\n" if $main::verbose > 1;
  } else {
    print "PARENT ($$) forked child ($pid) and returning 0;\n" if $main::verbose > 1;
    exit 0;
  }
}


print "Running '$prog' on ('",join("','",@ARGV),"')\n" if $main::verbose > 0;
print "\$progdir='$progdir'\n" if $main::verbose > 3;


$| = 1;
foreach my $dir (@ARGV) {
	print "Will Prase '$dir'\n" if $main::verbose > 1;
	my $prearchive_re = quotemeta($opts->{prearchive});
	if($dir !~ m{^$opts->{'in-dir'}}) {
		die "ERROR: Will only work on directories in '$opts->{'in-dir'}'!\n";
	}
	my $basedir = '';
	if($dir =~ m{^$opts->{'in-dir'}/([^/]+)$/?}) {
		$basedir = $1;
	} else {
		die "ERROR: Will only work on top-level directories in '$opts->{'in-dir'}'!\n";
	}
	my $new_basedir = '';
	my $match = $opts->{'dir-prefix'} ? "$opts->{'dir-prefix'}_" : "";
	if($basedir =~ m{^$match(\d\d\d\d\d\d\d\d_\d\d\d\d\d\d)\d\d\d$}) {
		if($opts->{prearchive}) {
			$new_basedir = "$opts->{prearchive}/$1";
		} else {
			$new_basedir = $basedir;
		}
	} else {
	  if(! $opts->{import} ) {
	    die("ERROR: Directory '$basedir' did not match expected regular expression.\n",
		"ERROR: RegExp='^$match(\\d\\d\\d\\d\\d\\d\\d\\d_\\d\\d\\d\\d\\d\\d)\\d\\d\\d\$'!\n",
		"ERROR: Did you specify the correct --dir-prefix (currently '$opts->{'dir-prefix'}')?\n");
	  } else {
	    chomp($new_basedir = `date +%Y%m%d_%H%M%S`);
	  }
	}
	my $dirparser = XNAT::DICOM::DirectoryParser->new($dir);
	$dirparser->parse();
	print "WARNINGS: (There were ".$dirparser->hadWarnings." warnings)\n" if $dirparser->hadWarnings() && $main::verbose > 1;
	print $dirparser->getWarnings() && $main::verbose > 1;
	print "ERRORS: (There were ".$dirparser->hadErrors." errors)\n" if $dirparser->hadErrors();
	print $dirparser->getErrors();
	print "All done.\n" if $main::verbose > 2;
	my @sessions = XNAT::DICOM::Session::getAll();
	die "ERROR: More than one session found in '$dir', not sure what to do!\n" if(@sessions > 1);

	my $session = shift(@sessions);

	my $t0=[gettimeofday];
	$session->check;
	print "WARNINGS: (There were ".$session->hadWarnings." warnings)\n" if $session->hadWarnings() && $main::verbose > 1;
	print $session->getWarnings() && $main::verbose > 1;
	print "ERRORS: (There were ".$session->hadErrors." errors)\n" if $session->hadErrors();
	print $session->getErrors();
	my $session_xml_file = $basedir.".xml";
	if($opts->{prearchive}) {
		# Move to the PreArchive
		if(! -e $new_basedir) {
			mkdir "$new_basedir" || die "ERROR: Unable to create directory '$new_basedir'\nREASON: $!\n ";
		}
		die "ERROR: No XNATStudyDirectory Defined!\n" unless $session->getHeader('XNATStudyDirectory');
		$new_basedir = $new_basedir.'/'.$session->getHeader('XNATStudyDirectory');
		if(! -e $new_basedir) {
			mkdir "$new_basedir" || die "ERROR: Unable to create directory '$new_basedir'\nREASON: $!\n ";
		}
		$session_xml_file = $new_basedir.".xml";
		my $raw_basedir = $new_basedir.'/RAW';
		if(! -e $raw_basedir) {
			mkdir "$raw_basedir" || die "ERROR: Unable to create directory '$raw_basedir'\nREASON: $!\n ";
		}
		print "Moving from $dir to $raw_basedir\n" if $main::verbose > 1;
		foreach my $file (XNAT::DICOM::File::getAll()) {
			$file->localMoveTo($raw_basedir);
		}
	}
	open(XML,"> $session_xml_file") || die "ERROR: Unable to open '$session_xml_file' for writing!\nREASON:$!\n ";
	print XML $session->asXML({extended_output=>$opts->{extra}});
	close(XML);
	foreach my $series ($session->getSeries) {
		my $scan_catalog = $new_basedir."/scan_".$series->getHeader('SeriesNumber')."_catalog.xml";
		open(XML,"> $scan_catalog") || die "ERROR: Unable to open '$scan_catalog' for writing!\nREASON:$!\n ";
		print XML $series->getSeriesXML(extended_output=>1);
		close(XML);
	}
	$stats->{xml_generation_time} = tv_interval($t0);

	if($dbh) {
		my $t0=[gettimeofday];
		$prep->{InsertSession}->execute($session->getHeader('StudyInstanceUID'),
																		$session->{label},
																		0, # <- need sent date
																		$session->getHeader('StudyDate')." ".$session->getHeader('StudyTime'),
																		$session->{size_on_disk},
																		$session->{uncompressed_size},
																	 );
		$session->{db_id} = $dbh->{mysql_insertid};
		if($opts->{'store-all'}) {
			foreach my $series ($session->getSortedSeries) {
				$prep->{InsertSeries}->execute(
																			 $series->getHeader('SeriesInstanceUID'),
																			 $series->getHeader('SeriesNumber'),
																			 $series->{label},
																			 $series->getHeader('SeriesDescription'),
																			 $series->getHeader('XNATSeriesType'),
																			 $session->{db_id},
																			 $series->{size_on_disk},
																			 $series->{uncompressed_size},
																			);
				$series->{db_id} = $dbh->{mysql_insertid};
				foreach my $dicom ($series->getSortedDicomFiles) {
					$prep->{InsertInstance}->execute(
																					 $dicom->getHeader('SOPInstanceUID'),
																					 $dicom->getHeader('InstanceNumber'),
																					 $dicom->{label},
																					 $series->{db_id},
																					 $session->{db_id},
																					);
					$dicom->{db_instance_id} = $dbh->{mysql_insertid};
					$prep->{InsertDirectory}->execute($dicom->getDirectory());
					$prep->{SelectDirectoryId}->execute($dicom->getDirectory());
					($dicom->{db_directory_id}) = $prep->{SelectDirectoryId}->fetchrow_array();
					$prep->{InsertFileName}->execute($dicom->getFileBasename());
					$prep->{SelectFileNameId}->execute($dicom->getFileBasename());
					($dicom->{db_filename_id}) = $prep->{SelectFileNameId}->fetchrow_array();
					$prep->{InsertFile}->execute(
																			 $dicom->{db_filename_id},
																			 $dicom->{db_directory_id},
																			 $dicom->getSizeOnDisk(),
																			 $dicom->{uncompressed_md5_checksum},
																			 $dicom->getDICOMSize(),
																			);
					$dicom->{db_file_id} = $dbh->{mysql_insertid};
					foreach my $headerType (keys %{$dicom->{headers}} ) {
						my $headerTypeId = $headerType2Id{$headerType};
						my $headerValue = $dicom->{headers}->{$headerType};
						my $headerId = $header2Id{"$headerType:$headerValue"};
						if(! $headerId) {
							if(! $headerTypeId) {
								#		$prep->{InsertHeaderType} = $dbh->prepare("INSERT IGNORE INTO HeaderType SET name=?;");
								$prep->{InsertHeaderType}->execute($headerType);
								$headerTypeId = $dbh->{mysql_insertid};
								$headerType2Id{$headerType} = $headerTypeId;
								print "New Header='$headerType' id='$headerTypeId'\n";
							}
							my $headerValueId = $headerValue2Id{$headerValue};
							if(! $headerValueId) {
								#$prep->{InsertHeaderValue} = $dbh->prepare("INSERT IGNORE INTO HeaderValue SET text=?;");
								$prep->{InsertHeaderValue}->execute($headerValue);
								#$prep->{SelectHeaderValueId} = $dbh->prepare("SELECT id FROM HeaderValue WHERE text=?");
								$prep->{SelectHeaderValueId}->execute($headerValue);
								$headerValueId = $prep->{SelectHeaderValueId}->fetchrow_array();
								$headerValue2Id{$headerValue} = $headerValueId;
							}
							$prep->{InsertHeaderType2HeaderValue}->execute($headerTypeId,$headerValueId);
							$prep->{SelectHeaderType2HeaderValueId}->execute($headerTypeId,$headerValueId);
							$headerId = $prep->{SelectHeaderType2HeaderValueId}->fetchrow_array();
							$header2Id{"$headerType:$headerValue"} = $headerId;
						}
						#$session->{db_id},$series->{db_id},$dicom->{db_instance_id});
						$prep->{InsertInstance2Header}->execute($dicom->{db_instance_id},$headerId);
						$prep->{InsertSeries2Header}->execute($series->{db_id},$headerId);
						$prep->{InsertSession2Header}->execute($session->{db_id},$headerId);
					}
				}
			}
			$stats->{execute_statements_time} = tv_interval($t0);
			print "Executed Statements in $stats->{execute_statements_time} seconds.\n";
		}
	}
	my $output_data_file = "$0.csv";
	if(open(CSVLOG,">> $output_data_file")) {
		if(0 == -s "$output_data_file") {
			print CSVLOG join(',',@{$dirparser->{csv_headers}})."\n"
		}
		print CSVLOG $dirparser->statsCSV() or die "FATAL ERROR: Unable to write to '$output_data_file'!\nREASON: $!\n";
		close CSVLOG;
	} else {
		print $dirparser->statsCSV();
		die "FATAL ERROR: Unable to open '$output_data_file' for writing!\nREASON: $!\n";
	}
	my $total_time =tv_interval($start_t0);
	if($dbh) {
		my $sql = "INSERT INTO DCM2XNATStats ";
		$sql .= "SET session_id='$session->{db_id}', ";
		$sql .= "start_time=FROM_UNIXTIME(".$^T."), ";
		$sql .= "end_time=FROM_UNIXTIME(".time()."), ";
		$sql .= "incoming_directory='".$opts->{'in-dir'}."', ";
		$sql .= "prearchive_directory='".$opts->{'prearchive'}."', ";
		$sql .= "readdir_time_seconds='".$dirparser->{readdir_time_seconds}."', ";
		$sql .= "parse_dicom_files_seconds='".$dirparser->{parse_dicom_files_seconds}."', ";
		$sql .= "total_dir_parsing_seconds='".$dirparser->{total_dir_parsing_seconds}."', ";
		$sql .= "total_database_seconds='".$stats->{execute_statements_time}."', " if $dbh && $opts->{'store-all'};
		$sql .= "total_xml_generation_seconds='".$stats->{xml_generation_time}."', ";
		$sql .= "total_seconds='".$total_time."', ";
		$sql .= "number_of_dicom_files='".$dirparser->{number_of_dicom_files}."', ";
		$sql .= "number_of_directory_entries='".$dirparser->{number_of_directory_entries}."', ";
		$sql .= "number_of_directories='".$dirparser->{number_of_directories}."', ";
		$sql .= "number_of_sessions='".$dirparser->{number_of_sessions}."', ";
		$sql .= "number_of_series='".$dirparser->{number_of_series}."', ";
		$sql .= "number_of_instances='".$dirparser->{number_of_instances}."', ";
		$sql .= "dicom_files_per_second='".$dirparser->{dicom_files_per_second}."'";
		$sql .= ";";
		print "SQL:\n$sql\n";
		$dbh->do($sql) || die "DBI::errstr = '$DBI::errstr'\nSQL: $sql\n ";
	}
	print "TOTAL TIME: ",$total_time," seconds.\n";
}
exit;

__END__
